20TJ

Technical details

Show code

library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(kableExtra)
library(plotly)
library(GeoLocTools)
setupGeolocation()
knitr::opts_chunk$set(echo = FALSE)
load(paste0("../data/1_pressure/", params$gdl_id, "_pressure_prob.Rdata"))
load(paste0("../data/2_light/", params$gdl_id, "_light_prob.Rdata"))
load(paste0("../data/3_static/", params$gdl_id, "_static_prob.Rdata"))
load(paste0("../data/4_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))
load(paste0("../data/5_wind_graph/", params$gdl_id, "_wind_graph.Rdata"))
col <- rep(RColorBrewer::brewer.pal(8, "Dark2"), times = ceiling(max(pam$sta$sta_id) / 8))

Settings used

All the results produced here are generated with (1) the raw geolocator data, (2) the labeled files of pressure and light and (3) the parameters listed below.

Show code

kable(gpr) %>% scroll_box(width = "100%")

gdl_id	keep	crop_start	crop_end	thr_dur	extent_N	extent_W	extent_S	extent_E	map_scale	map_max_sample	map_margin	prob_map_s	prob_map_s_calib	prob_map_thr	shift_k	kernel_adjust	calib_lon	calib_lat	calib_1_start	calib_1_end	calib_2_start	calib_2_end	calib_2_lon	calib_2_lat	prob_light_w	thr_prob_percentile	thr_gs	thr_as	RingNo	scientific_name	common_name	mass	wing_span	Color	sta_id_winter
20TJ	2	2018-08-01	2018-11-08 05:50:00	0	51	-18	5	16	4	300	30	1	1.3	0.9	0	1.4	8.703374	46.55014	2018-08-01	2018-09-11	NA	NA	NA	NA	0.09	0.95	120	100	N566688	Oenanthe oenanthe	Northern wheatear	NA	NA	#B6E880	12

Pressure timeserie

The labeling of pressure data is illustrated with this figure. The black dots indicates the pressure datapoint not considered in the matching. Each stationary period is illustrated by a different colored line.

Show code

pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutlier | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  # geom_point(data = subset(pam$pressure, isoutlier), aes(x = date, y = obs), colour = "black") +
  # geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie) %>% filter(sta_id > 0), aes(x = date, y = pressure0, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Pressure calibration

Show code

pressure_ts_bind <- do.call("rbind", shortest_path_timeserie) %>%
  filter(!is.na(sta_id))

pam$pressure %>%
  left_join(pressure_ts_bind %>% dplyr::select(c("date", "pressure0")), by = "date") %>%
  mutate(diff = ifelse(is.na(pressure0), 0, obs - pressure0)) %>%
  filter(sta_id > 0 & !isoutlier) %>%
  group_by(sta_id) %>%
  mutate(sta_id = paste0(sta_id, " (SD=", round(sd(diff), 2), " ; N=", n(), ")")) %>%
  ggplot(aes(x = diff)) +
  geom_histogram(aes(y = (..count..) / tapply(..count.., ..PANEL.., sum)[..PANEL..]), binwidth = .2) +
  facet_wrap(~sta_id) +
  scale_x_continuous(name = "Pressure Geolocator - best match ERA5 (hPa)") +
  scale_y_continuous(name = "Normalized histogram")

Light

Show code

raw_geolight <- pam$light %>%
  transmute(
    Date = date,
    Light = obs
  )
lightImage(tagdata = raw_geolight, offset = 0)
tsimagePoints(twl$twilight,
  offset = 0, pch = 16, cex = 1.2,
  col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
abline(v = gpr$calib_2_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_2_end, lty = 2, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_end, lty = 2, col = "firebrick", lwd = 1.5)

Show code

hist(z, freq = F)
lines(fit_z, col = "red")

The probability map resulting from light data alone can be seen below.

Show code

li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(light_prob))) {
  i_s <- metadata(light_prob[[i_r]])$sta_id
  info <- pam$sta[pam$sta$sta_id == i_s, ]
  info_str <- paste0(i_s, " | ", info$start, "->", info$end)
  li_s <- append(li_s, info_str)
  l <- l %>% addRasterImage(light_prob[[i_r]], opacity = 0.8, colors = "OrRd", group = info_str)
}
l %>%
  addCircles(lng = gpr$calib_lon, lat = gpr$calib_lat, color = "black", opacity = 1) %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Light vs Pressure

We can compare light and pressure location at long stationary stopover (>5 days). By assuming the best match of the pressure to be the truth, we can plot the histogram of the zenith angle and compare to the fit of kernel density at the calibration site.

Show code

 raw_geolight <- pam$light %>%
    transmute(
      Date = date,
      Light = obs
    )
 dur <- unlist(lapply(pressure_prob, function(x) difftime(metadata(x)$temporal_extent[2],metadata(x)$temporal_extent[1], units = "days" )))
  long_id <- which(dur>5)

  par(mfrow = c(2, 3))
  for (i_s in long_id){
    twl_fl <- twl %>%
      filter(!deleted) %>%
      filter(twilight>shortest_path_timeserie[[i_s]]$date[1] & twilight<tail(shortest_path_timeserie[[i_s]]$date,1))
    sun <-  solar(twl_fl$twilight)
    z_i <- refracted(zenith(sun, shortest_path_timeserie[[i_s]]$lon[1], shortest_path_timeserie[[i_s]]$lat[1]))
    hist(z_i, freq = F, main = paste0("sta_id=",i_s, " | ",nrow(twl_fl),"twls"))
    lines(fit_z, col = "red")
    xlab("Zenith angle")
  }

Similarly, we can plot the line of sunrise/sunset at the best match of pressure (yellow line) and compare to the raw and labeled light data.

Show code

  lightImage(
    tagdata = raw_geolight,
    offset = gpr$shift_k / 60 / 60
  )
  tsimagePoints(twl$twilight,
                offset = gpr$shift_k / 60 / 60, pch = 16, cex = 1.2,
                col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
  )
  for (ts in shortest_path_timeserie){
    twl_fl <- twl %>%
      filter(twilight>ts$date[1] & twilight<tail(ts$date,1))
    if (nrow(twl_fl)>0){
    tsimageDeploymentLines(twl_fl$twilight,
                           lon = ts$lon[1], ts$lat[1],
                           offset = gpr$shift_k / 60 / 60, lwd = 3,col = adjustcolor("orange", alpha.f = 0.5))
      
    }
  }

Stationay period information

Show code

read_csv(paste0("../reports/figure_print/table_transition/transition_", params$gdl_id, ".csv")) %>% kable() %>% scroll_box(width = "100%")

…1	sta_id_s	sta_id_t	flight_duration	as_m	as_s	gs_m	gs_s	ws_m	ws_s	dist_m	dist_s	ws_m_support	ws_m_drift	start_flight	end_flight	sunrise	sunset	as_sp	gs_sp	ws_sp	dist_sp	ws_sp_support	ws_sp_drift	alt_min	alt_max	alt_mean	alt_med	alt_sumdabsdiff	alt_sumposdiff	gdl_id
1	1	2	6.5	32.43513	7.689994	39.91235	10.02956	9.269177	2.533759	259.43025	65.19215	7.853152	4.923987	2018-09-10 18:00:00	2018-09-11 00:30:00	2018-09-11 04:35:31	2018-09-10 18:18:06	34.43254	45.32069	10.950318	294.58450	10.903129	1.0155072	1862.10614	4764.1579	3891.7798	4298.2386	6268.2856	3018.5932	20TJ
2	2	3	5.0	39.33389	12.053210	35.81438	12.41859	6.606142	2.561573	179.07188	62.09294	-3.083178	5.842527	2018-09-12 19:00:00	2018-09-13 00:00:00	2018-09-13 04:43:27	2018-09-12 18:16:02	28.35551	22.96060	6.000728	114.80300	-5.244567	2.9160346	144.91843	3853.9612	1937.2728	1687.6263	4593.9686	662.3002	20TJ
3	3	4	9.5	59.99573	13.214048	83.26211	14.02501	24.729876	1.590939	790.99009	133.23760	23.688195	7.101843	2018-09-13 18:30:00	2018-09-14 04:00:00	2018-09-14 04:38:28	2018-09-13 18:18:36	55.54795	80.55483	25.591497	765.27089	25.190486	4.5126604	21.75066	4054.8460	2435.0493	3040.3677	9771.6018	4946.4769	20TJ
4	4	5	4.5	37.60068	17.173692	41.37704	19.75118	9.783523	5.617744	186.19670	88.88032	4.760682	8.547118	2018-09-14 18:30:00	2018-09-14 23:00:00	2018-09-15 04:40:13	2018-09-14 17:59:05	26.37476	30.82453	8.023529	138.71039	5.172840	6.1334120	150.67444	798.1368	462.3851	455.5424	755.6198	701.5411	20TJ
5	5	6	10.5	42.90239	10.306387	43.00580	10.80056	13.591453	2.887570	451.56095	113.40592	2.250991	13.403755	2018-10-06 18:00:00	2018-10-07 04:30:00	2018-10-07 05:00:41	2018-10-06 17:25:55	40.38932	45.75348	10.392652	480.41156	6.230034	8.3182864	171.34883	2520.2774	1439.1285	1405.2512	6230.0917	2759.4391	20TJ
6	6	7	11.5	49.86674	15.224406	63.21378	13.95020	14.037287	2.298830	726.95844	160.42733	13.496546	3.858584	2018-10-07 17:30:00	2018-10-08 05:00:00	2018-10-08 05:09:02	2018-10-07 17:29:32	35.17941	49.57066	14.778768	570.06264	14.505270	2.8300437	120.44313	2839.8466	2067.8788	2237.9434	5747.2758	3190.7611	20TJ
7	7	8	11.0	33.96273	14.420341	47.58598	13.88443	16.945471	3.924526	523.44577	152.72870	14.690330	8.446489	2018-10-08 17:30:00	2018-10-09 04:30:00	2018-10-09 05:18:15	2018-10-08 17:38:40	29.50622	46.36382	16.862586	510.00204	16.859416	0.3269645	773.41362	2897.8323	1326.7617	1220.6917	6441.5637	3335.3866	20TJ
8	8	9	11.0	40.49808	14.624979	50.43056	15.05772	15.490626	5.113244	554.73619	165.63493	11.333474	10.559917	2018-10-09 18:00:00	2018-10-10 05:00:00	2018-10-10 05:25:05	2018-10-09 17:48:58	33.08022	46.77687	15.954814	514.54558	14.412365	6.8439623	461.59257	2527.0318	1163.4740	958.5288	9220.7891	4547.8161	20TJ
9	9	10	3.5	38.85012	15.449402	45.81142	15.38688	11.119153	4.661256	160.33998	53.85407	7.781795	7.942244	2018-10-10 19:30:00	2018-10-10 23:00:00	2018-10-11 05:28:01	2018-10-10 17:57:40	25.14121	32.80365	10.248472	114.81279	8.368438	5.9161145	286.71528	2068.5426	1103.6547	1018.3637	3418.7972	1636.9699	20TJ
10	10	11	1.0	35.00795	16.175639	36.04533	19.09359	14.649945	3.892500	36.04533	19.09359	3.999552	14.093420	2018-10-11 02:30:00	2018-10-11 03:30:00	2018-10-11 05:27:07	2018-10-10 18:00:57	26.18057	38.29653	15.173305	38.29653	13.205258	7.4733074	293.60101	940.7753	517.3558	317.6910	1270.2585	647.1743	20TJ
11	11	12	5.0	30.85021	13.488974	32.58968	14.85545	15.198543	8.343992	162.94839	74.27724	5.237049	14.267762	2018-10-11 21:00:00	2018-10-12 02:00:00	2018-10-12 05:25:35	2018-10-11 17:59:07	25.58039	39.09843	18.883801	195.49213	15.741407	10.4310135	280.05243	1706.7967	804.9680	838.2029	5043.5970	2563.5318	20TJ